home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / rk_plot.zip / EXAMPLE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-13  |  6KB  |  172 lines
  1. {
  2. ┌───────────────────────────────────────────────────────────────────────────┐
  3. │                                                                           │
  4. │ Demonstrationsprogramm zur Anwendung von Routinen der Unit PLOT           │
  5. │                                                                           │
  6. │ Copyright (C) 1991, Hans-Jürgen Herrler und Dieter Sosna                  │
  7. │                                                                           │
  8. └───────────────────────────────────────────────────────────────────────────┘
  9. }
  10.  
  11. {$A+,F+,R-,S-}
  12. {$M 16384,0,655360}
  13.  
  14. PROGRAM Example;
  15.  
  16. USES Crt, Graph, Plot;
  17.  
  18. CONST
  19.     TreiberPfad     = '';   { Pfad für Grafiktreiber *.BGI, bitte anpassen! }
  20.  
  21. VAR
  22.     GrafikTreiber,
  23.     GrafikModus             : Integer;
  24.  
  25.     Matrix                  : Array[1..30,1..33] of Float;
  26. {   Im Feld "Matrix" werden die an den Stützstellen berechneten Funktions-
  27.     werte abgelegt. Sollen wesentlich mehr Punkte berücksichtigt werden,
  28.     so paßt das Feld nicht mehr ins Datensegment - man kann dann die Matrix
  29.     zeilenweise auf dem Heap ablegen, aber lückenlos(!) Zeile hinter Zeile. }
  30.  
  31.     MatrixParm              : MatrixParameter;
  32.     BildParm                : BildParameter;
  33.  
  34.     Mono                    : Boolean;      { 2- oder 16-Farben-Modus       }
  35.  
  36. { ========================================================================= }
  37.  
  38. FUNCTION Fkt(x, y: Float): Float;
  39. BEGIN
  40. {   Hier darzustellende Anwenderfunktion eintragen:                         }
  41.     Fkt := (Cos(x) - Sin(2*x)) * Cos(y)
  42.     END;
  43.  
  44. { ------------------------------------------------------------------------- }
  45. PROCEDURE FunktionswerteBerechnen;
  46. VAR
  47.     i, j                    : Byte;
  48.     X, Y, Z,
  49.     XMin, XMax, XSchritt,
  50.     YMin, YMax, YSchritt    : Float;
  51.  
  52. BEGIN
  53. {   Intervallgrenzen                                                        }
  54.     XMin := 0;  XMax := 6;  YMin := -3; YMax := 6;
  55.  
  56.     WITH MatrixParm DO BEGIN
  57. {   Zahl der Gitterpunkte                                                   }
  58.         XGitter := 33;
  59.         YGitter := 30;
  60.  
  61. {   Funktionswerte berechnen, in Matrix ablegen                             }
  62.         XSchritt := (XMax-XMin)/(XGitter-1);
  63.         YSchritt := (YMax-YMin)/(YGitter-1);
  64.         ZMin := Fkt(1,1);   ZMax := ZMin;
  65.         y := YMin;
  66.         FOR i := 1 TO YGitter DO BEGIN
  67.             x := XMin;
  68.             FOR j:= 1 TO XGitter DO BEGIN
  69.                 z := Fkt(x, y);
  70.                 IF z > ZMax THEN ZMax := z;
  71.                 IF z < ZMin THEN ZMin := z;
  72.                 Matrix[i, j] := z;
  73.                 x := x + XSchritt
  74.                 END;
  75.             y := y + YSchritt
  76.             END
  77.         END
  78.     END;    { FunktionswerteBerechnen }
  79. { ------------------------------------------------------------------------- }
  80. PROCEDURE VierBilder;
  81. BEGIN
  82.  
  83. { Teilbild links oben:                                                      }
  84.  
  85.     WITH BildParm DO BEGIN
  86.         SchirmLinks := 0;       SchirmRechts    := 0.48;
  87.         SchirmOben  := 0;       SchirmUnten     := 0.48;
  88.         IF Mono THEN BEGIN
  89.             ColorLine   := 1;
  90.             ColorFrame  := 1;
  91.             ColorFillO  := 0;
  92.             ColorFillU  := 0;
  93.             ColorFillX  := 0;
  94.             ColorFillY  := 0
  95.             END
  96.         ELSE BEGIN
  97.             ColorLine   := White;
  98.             ColorFrame  := White;
  99.             ColorFillO  := Green;
  100.             ColorFillU  := Brown;
  101.             ColorFillX  := Magenta;
  102.             ColorFillY  := Cyan
  103.             END;
  104.         Projekt     := ParallelProjektion;
  105.         BrennweiteZuAbstand := 0.11;
  106.         Alpha       := 33;
  107.         Gamma       := 25;
  108.         END;
  109.     VolumenPerspektive(Matrix, MatrixParm, BildParm, True);
  110.  
  111. { Teilbild rechts oben:                                                     }
  112.  
  113.     WITH BildParm DO BEGIN
  114.         SchirmLinks := 0.52;    SchirmRechts    := 1;
  115.         SchirmOben  := 0;       SchirmUnten     := 0.48;
  116.         IF Not Mono THEN BEGIN
  117.             ColorLine   := Yellow;
  118.             ColorFillO  := Brown;
  119.             ColorFillU  := Blue;
  120.             ColorFillX  := LightBlue;
  121.             ColorFillY  := LightMagenta
  122.             END;
  123.         Projekt     := ZentralProjektion;
  124.         Alpha       := -38;
  125.         Gamma       := 23;
  126.         Brennweite  := 30;
  127.         Abstand     := 300
  128.         END;
  129.     VolumenPerspektive(Matrix, MatrixParm, BildParm, True);
  130.  
  131. { Teilbild links unten:                                                     }
  132.  
  133.     WITH BildParm DO BEGIN
  134.         SchirmLinks := 0;       SchirmRechts    := 0.48;
  135.         SchirmOben  := 0.52;    SchirmUnten     := 1;
  136.         IF Not Mono THEN ColorLine  := LightGreen;
  137.         Projekt     := ParallelProjektion;
  138.         BrennweiteZuAbstand := 0.11;
  139.         Alpha       := -144;
  140.         Gamma       := 20;
  141.         END;
  142.     AlphaScheibenPerspektive(Matrix, MatrixParm, BildParm);
  143.  
  144. { Teilbild rechts unten:                                                    }
  145.  
  146.     WITH BildParm DO BEGIN
  147.         SchirmLinks := 0.52;    SchirmRechts    := 1;
  148.         SchirmOben  := 0.52;    SchirmUnten     := 1;
  149.         IF Not Mono THEN ColorLine := LightMagenta;
  150.         Projekt     := ParallelProjektion;
  151.         BrennweiteZuAbstand := 0.11;
  152.         Alpha       := -124;
  153.         Gamma       := 30;
  154.         END;
  155.     GitterFlaechenPerspektive(Matrix, MatrixParm, BildParm, True);
  156.  
  157.     END;    { VierBilder }
  158.  
  159. { ===== Hauptprogramm ===================================================== }
  160.  
  161. BEGIN
  162.     GrafikTreiber := Detect;
  163.     InitGraph(GrafikTreiber, GrafikModus, TreiberPfad);
  164.     Mono := (GetMaxColor < 15);
  165.     OutTextXY(20, 20, 'Funktionswerte werden berechnet ...');
  166.     FunktionswerteBerechnen;
  167.     ClearDevice;
  168.     VierBilder;
  169.     REPEAT UNTIL KeyPressed;
  170.     CloseGraph
  171.     END.
  172.